home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Language/OS - Multiplatform Resource Library
/
LANGUAGE OS.iso
/
simula
/
books
/
books.lha
/
kirkerud
/
studchain2.sim
< prev
next >
Wrap
Text File
|
1993-08-16
|
17KB
|
427 lines
% ****************************************************************
% * *
% * This is a revised version of the program constructed in *
% * section 14.3 of *
% * Object Oriented Programming with Simula by Bj|rn Kirkerud; *
% * The revisions in the program consist in the use of *
% * a few classes containing generally useful tools *
% * *
% ****************************************************************
begin
% ****************************************************************
% * *
% * Declarations of classes containing generally usefull tools: *
% * *
% ****************************************************************
external class promptools, texttools, filetools;
ref(promptools) pt;
ref(texttools) tt;
ref(filetools) ft;
procedure outline(line); text line;
begin outtext(line); outimage end;
% ****************************************************************
% * *
% * The class Student: *
% * *
% ****************************************************************
class Student;
begin
! Variables to keep the data that describe this student: ;
integer ident, year, month, day, form;
Boolean female;
character math_grade, eng_grade, hist_grade;
! A procedure with a value which is unique for this student: ;
text procedure key;
key :- tt.int_as_text(ident);
! A variable to hold a reference to the next Student in a pointer chain: ;
ref(Student) next_in_chain;
! Data access procedures: ;
procedure read;
begin
ident := pt.ask_for_int("Identity number? ");
year := pt.ask_for_int("Year of birth? ");
month := pt.ask_for_int("Month? ");
day := pt.ask_for_int("Day? ");
form := pt.ask_for_int("Form? ");
female := pt.ask_for_bool("Female? ");
math_grade := pt.ask_for_char("Grade in mathematics? ");
eng_grade := pt.ask_for_char("Grade in English? ");
hist_grade := pt.ask_for_char("Grade in history? ");
end of Student'read;
procedure write;
begin
outtext("Data for student: "); outint(ident, 6);
outtext(". Born: ");
outint(day, 2); outchar('/');
outint(month, 2); outchar('/');
outint(year, 4);
outline(if female then ". Female." else ". Male.");
outline(" Form: " & tt.int_as_text(form) & "." &
" Current grades:" &
" Mathematics: " & tt.char_as_text(math_grade) &
" English: " & tt.char_as_text(eng_grade) &
" History: " & tt.char_as_text(hist_grade));
end of Student'write;
procedure change;
begin character attribute;
attribute := pt.ask_for_char("What do you want to change? ");
if attribute = 'i' then ident
:= pt.ask_for_int("New identity number? ") else
if attribute = 'y' then year
:= pt.ask_for_int("New birth year? ") else
if attribute = 'm' then month
:= pt.ask_for_int("New birth month? ") else
if attribute = 'd' then day
:= pt.ask_for_int("New day of birth? ") else
if attribute = 'f' then form
:= pt.ask_for_int("New form number? ") else
if attribute = 's' then female
:= pt.ask_for_bool("Female? ") else
if attribute = 'a' then math_grade
:= pt.ask_for_char("New grade in math? ") else
if attribute = 'e' then eng_grade
:= pt.ask_for_char("New grade in English? ") else
if attribute = 'h' then hist_grade
:= pt.ask_for_char("New grade in history? ")
else begin
outline("You can change one of the following attributes:");
outline(" i: Identity number");
outline(" y: Birth year");
outline(" m: Birth month");
outline(" d: Day of birth");
outline(" f: Form number");
outline(" s: Sex");
outline(" a: Grade in mathematics");
outline(" e: Grade in English");
outline(" h: Grade in history");
change; ! Observe that this is an invocation of the procedure
! being declared. The effect is that user is given
! another chance to change;
end;
end of Student'change;
character procedure worst_grade;
worst_grade := max(math_grade, max(eng_grade, hist_grade));
procedure put_in_record(outf); ref(outfile) outf;
begin
ft.int_to_file(outf, ident);
ft.int_to_file(outf, year);
ft.int_to_file(outf, month);
ft.int_to_file(outf, day);
ft.int_to_file(outf, form);
ft.bool_to_file(outf, female);
outf.outchar(math_grade);
outf.outchar(eng_grade);
outf.outchar(hist_grade);
end;
procedure get_from_record(inf); ref(infile) inf;
begin
ident := ft.int_from_file(inf);
year := ft.int_from_file(inf);
month := ft.int_from_file(inf);
day := ft.int_from_file(inf);
form := ft.int_from_file(inf);
female := ft.bool_from_file(inf);
math_grade := inf.inchar;
eng_grade := inf.inchar;
hist_grade := inf.inchar;
end;
end of Student;
% ****************************************************************
% * *
% * The class School: *
% * *
% ****************************************************************
class School;
protected first_in_chain, last_in_traversal;
begin
! Declaration of a variable to hold a reference to the first Student
! in the pointer chain: ;
ref(Student) first_in_chain;
! Declaration of a variable to hold a reference to the Student
! last vistited in a traversal of the chain: ;
ref(Student) last_in_traversal;
! Declarations of data access procedures: ;
procedure Place_student(a_student, student_exists);
name student_exists; ref(Student) a_student; Boolean student_exists;
begin
student_exists := false;
if first_in_chain == none
then first_in_chain :- a_student
! The new object is placed first;
else if a_student.key < first_in_chain.key
then begin
a_student.next_in_chain :- first_in_chain;
first_in_chain :- a_student;
! The new object is placed first;
end
else begin ref(Student) aux_stud; Boolean aux_found;
aux_stud :- first_in_chain; aux_found := false;
while not aux_found do
if aux_stud.next_in_chain == none then aux_found := true
else if a_student.key < aux_stud.next_in_chain.key
then aux_found := true
else aux_stud :- aux_stud.next_in_chain;
if a_student.key = aux_stud.key
then student_exists := true
else begin
a_student.next_in_chain :- aux_stud.next_in_chain;
aux_stud.next_in_chain :- a_student;
! The new object is placed after aux_stud;
end;
end;
end of Place_student;
ref(Student) procedure find_student(key); text key;
! This version assumes that the pointer chain is sorted
! on increasing key-values;
begin ref(Student) aux_stud; Boolean found;
aux_stud :- first_in_chain;
while aux_stud =/= none and not found do
if aux_stud.key > key then aux_stud :- none else
if aux_stud.key = key then found := true
else aux_stud :- aux_stud.next_in_chain;
find_student :- aux_stud;
end of find_student;
ref(Student) procedure first_student;
begin
first_student :- first_in_chain;
last_in_traversal :- first_in_chain;
end;
ref(Student) procedure next_student;
if last_in_traversal == none then next_student :- none
else begin
last_in_traversal :- last_in_traversal.next_in_chain;
next_student :- last_in_traversal;
end;
procedure Remove_specified_student(key, no_such_student);
name no_such_student; text key; Boolean no_such_student;
begin ref(Student) aux_stud, pred_stud; Boolean found;
aux_stud :- first_in_chain;
while aux_stud =/= none and not found do
if aux_stud.key = key then found := true
else begin
pred_stud :- aux_stud;
aux_stud :- aux_stud.next_in_chain;
end;
if aux_stud == none then no_such_student := true
else begin
no_such_student := false;
if pred_stud == none
then first_in_chain :- first_in_chain.next_in_chain
else pred_stud.next_in_chain :- aux_stud.next_in_chain;
end;
end of Remove_student;
end of School;
% ****************************************************************
% * *
% * Start of School-context: *
% * *
% ****************************************************************
School begin
% ****************************************************************
% * *
% * Declarations of command procedures: *
% * *
% ****************************************************************
procedure Give_help;
begin
outline("The legal commands are: ");
outline(" ?: Help (writes this text)");
outline(" N: To enter data about a new student");
outline(" W: Writes data about a specified student");
outline(" L: Writes a list with all students");
outline(" C: Changes data about a specified student");
outline(" R: Removes all data about a specified student");
outline(" P: Puts all data to file ""stud.dta""");
outline(" G: Gets data from file ""stud.dta""");
outline(" B: Writes students with bad grades");
outline(" Q: Quit (the program execution stops)");
end of Give_help;
procedure Enter_student;
begin ref(Student) a_student; Boolean ident_exists;
a_student :- new Student;
a_student.read;
Place_student(a_student, ident_exists);
if ident_exists
then outline("The identity number is already in use!")
else outline("The data have been stored.");
end of Enter_student;
procedure Write_student;
begin integer ident_number; ref(Student) a_student;
ident_number := pt.ask_for_int("Identity number? ");
a_student :- find_student(tt.int_as_text(ident_number));
if a_student == none
then outline("No student with that identity number!")
else a_student.write;
end of Write_student;
procedure List_students;
begin ref(Student) a_student;
outline("The students for which data have been entered:");
a_student :- first_student;
while a_student =/= none do
begin a_student.write; a_student :- next_student end;
end of List_students;
procedure Change_student;
begin ref(Student) a_student; integer ident_number;
ident_number := pt.ask_for_int("Identity number? ");
a_student :- find_student(tt.int_as_text(ident_number));
if a_student == none
then outline("No student with that identity number!")
else begin a_student.write; a_student.change end;
end of Change_student;
procedure Remove_student;
begin integer ident_number; Boolean no_such_student;
ident_number := pt.ask_for_int("Identity number? ");
Remove_specified_student(tt.int_as_text(ident_number), no_such_student);
if no_such_student
then outline("No student with that identity number!")
else outline("The student has been removed!");
end of Remove_student;
procedure Put_to_file;
inspect new outfile("stud.dta") do
begin ref(Student) a_student;
open(blanks(24));
a_student :- first_student;
while a_student =/= none do
begin
a_student.put_in_record(this outfile);
outimage;
a_student :- next_student;
end;
close;
end;
procedure Get_from_file;
inspect new infile("stud.dta") do
if open(blanks(24))
then begin ref(Student) a_student; Boolean ident_exists;
inimage;
while not endfile do
begin
a_student :- new Student;
a_student.get_from_record(this infile);
Place_student(a_student, ident_exists);
inimage;
end;
close;
end
else outline("File stud.dta can not be opened for reading");
procedure Bad_grades;
begin character grade_limit; ref(Student) a_student;
grade_limit := pt.ask_for_char("Grade limit? ");
a_student :- first_student;
while a_student =/= none do
begin
if a_student.worst_grade ge grade_limit then a_student.write;
a_student :- next_student;
end;
end of Bad_grades;
procedure Unknown_command(c); character c;
begin
outline(" You gave the command '" & tt.char_as_text(c) & "'" &
" This is not among the legal commands.");
outline(" Type ? if you don't remember the legal commands");
end of Unknown command;
% ****************************************************************
% * *
% * Declaration of a variable to keep the latest command *
% * typed by the user: *
% * *
% ****************************************************************
character command;
% ****************************************************************
% * *
% * That was the last declaration. *
% * Now come the imperatives of the program: *
% * *
% ****************************************************************
pt :- new promptools;
tt :- new texttools;
ft :- new filetools;
command := pt.ask_for_char("Type your first command (? for help) > ");
while command ne 'Q' do
begin
if command = '?' then Give_help else
if command = 'N' then Enter_student else
if command = 'W' then Write_student else
if command = 'L' then List_students else
if command = 'C' then Change_student else
if command = 'R' then Remove_student else
if command = 'P' then Put_to_file else
if command = 'G' then Get_from_file else
if command = 'B' then Bad_grades
else Unknown_command(command);
command := pt.ask_for_char("Your next command > ");
end;
outline("Bye");
end of block prefixed by School;
end
